home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 33
/
033.d81
/
jig is up
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
5KB
|
179 lines
1 dim nt(8,8)
10 :
20 print"[147][144]":poke53280,6:poke53281,5
30 for cl=54272to54296:poke cl,0:next cl:rem clear sonic adresses
40 print " the jig is up"
50 print" by
60 [153]" paul g. mulvaney, iii
70 print" "
80 print" type preference:"
90 print" jigs(j) or reels(r)"
92 print:print" press 'q' at any time to quit"
95 ag$="please wait while i compose your "
100 get i$: if i$="j"goto140
110 ifi$="r"goto130
115 ifi$="q"then60000
120 goto100
130 s=8:t$="reel.": goto150
140 s=6:t$="jig."
150 print"[147]";
151 z=z+1:print" [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":print" "ag$t$
152 print" [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
160 for b=1to8
165 print""spc(19)8-b
170 for n=1tos
175 ifpeek(198)<>0thengeta$:ifa$="q"then20
180 rem********************************
190 kl=0:rem prevents endless loop
200 kl=kl+1:ifkl=25then160
210 nt(b,n)=int(rnd(0)*15+1):ifb*n<8*sthengoto290:rem note generator & last note
220 rem********************************
230 rem lines24-26 put last note in tonic chord
240 ifnt(8,s)=nt(4,s)orabs(nt(8,s)-nt(4,s))=2orabs(nt(8,s)-nt(4,s))=4then320
250 ifabs(nt(8,s)-nt(4,s))=7then320
260 goto200
270 rem*********************************
280 rem line 29 repeats opening theme
290 nt(5,n)=nt(1,n):nt(6,n)=nt(2,n)
300 rem********************************
310 rem lines 32-34 disallow huge intervals other than octaves
320 ifabs(nt(b,n)-nt(b,n-1))=7then500
330 kl=kl+1:ifkl=25then160:rem antilock
340 ifabs(nt(b,n)-nt(b,n-1))>4goto200
350 rem*********************************
360 rem lines 37-43 create chords 20% of the time
370 ifn=sgoto500
380 ifnt(b,n)=1goto1020
390 ifnt(b,n)=15goto1070
400 nq=int(rnd(0)*30+1):onnqgoto500,500,500,500,500,500,500,500,500
410 onnq-9goto880,900,920,940,960,980
420 onnq-15goto500,500,500,500,500,500,500,500
430 onnq-23goto500,500,500,500,500,500,500
440 rem*********************************
450 rem lines46-49 keep chord progressions in range of tinwhistle (&array!)
460 if nt(b,n)>15thennt(b,n)=nt(b,n)-7
470 ifnt(b,n)<1thennt(b,n)=nt(b,n)+7
480 if nt(b,n+1)<1thennt(b,n+1)=nt(b,n+1)+7
490 if nt(b,n+1)>15thennt(b,n+1)=nt(b,n+1)-7
500 next n
510 nextb
515 print"[147]";:mm=0
520 rem********************************
530 rem lines 54-67 play tune 2x
540 fortw=1to2
550 forb=1to8
560 forn=1tos
570 onnt(b,n)goto710,720,730,740,750
580 onnt(b,n)-5goto760,770,780,790,800
590 onnt(b,n)-10goto810,820,830,840,850
600 poke54296,15:poke54277,136:poke54278,136:poke54276,17
610 if(mm=.)and(s=6)thenprint,
615 poke54273,h:poke54272,l:printn$,:mm=mm+1:ifmm=3thenmm=0
620 if n/s=int(n/s)thenprint"--------------------------------------":goto640
630 if2*n/s=int(2*n/s)thenprint"......................................."
640 forqt=1to15:nextqt:poke54276,16
645 ifpeek(198)<>0thengeta$:ifa$="q"then20
650 nextn
660 nextb
670 nexttw
680 gosub1140
690 goto150
700 rem note assignments***************
710 n$="d":h=9:l=104:goto600
720 n$="e":h=10:l=143:goto600
730 n$="f#":h=11:l=218:goto600
740 n$="g":h=12:l=143:goto600
750 n$="a":h=14:l=24:goto600
760 n$="b":h=15:l=210:goto600
770 n$="c#":h=17:l=195:goto600
780 n$="d^":h=18:l=209:goto600
790 n$="e^":h=21:l=31:goto600
800 n$="f#^":h=23:l=181:goto600
810 n$="g^":h=25:l=30:goto600
820 n$="a^":h=28:l=49:goto600
830 n$="b^":h=31:l=165:goto600
840 n$="c#^":h=35:l=134:goto600
850 n$="d^^":h=37:l=162:goto600
860 rem********************************
870 rem 6 ways to play a diatonic chord, chosen randomly at line 41
880 nt(b,n)=nt(b,n-1)+2
890 nt(b,n+1)=nt(b,n)+2:goto460
900 nt(b,n)=nt(b,n-1)+4
910 nt(b,n+1)=nt(b,n)-2:goto460
920 nt(b,n)=nt(b,n-1)+2
930 nt(b,n+1)=nt(b,n)-4:goto460
940 nt(b,n)=nt(b,n-1)-2
950 nt(b,n+1)=nt(b,n)+4:goto460
960 nt(b,n)=nt(b,n-1)-2
970 nt(b,n+1)=nt(b,n)-2:goto460
980 nt(b,n)=nt(b,n-1)-4
990 nt(b,n+1)=nt(b,n)+2:goto460
1000 rem********************************
1010 rem special cases for "d" chords
1020 ifn>(s-2)goto500
1030 qn=int(rnd(0)*10+1):onqngoto500,500,500,500,500
1040 onqn-5goto500,500,500,1050,1060
1050 nt(b,n+1)=nt(b,n)+2:nt(b,n+2)=nt(b,n)+4:goto500
1060 nt(b,n+1)=nt(b,n)+4:nt(b,n+2)=nt(b,n)+2:goto500
1070 ifn>(s-2)goto500
1080 qq=int(rnd(0)*10+1):onqqgoto500,500,500,500,500
1090 onqq-5goto500,500,500,1100,1110
1100 nt(b,n+1)=nt(b,n)-4:nt(b,n+2)=nt(b,n)-2:goto500
1110 nt(b,n+1)=nt(b,n)-2:nt(b,n+2)=nt(b,n)-4:goto500
1120 rem********************************
1130 rem printer option with timer loop
1140 ifs=6goto1160
1150 ifs=8thenprint"printout this fine reel?":goto1170
1160 print" printout this lovely jig?"
1170 print"answer 'y'(yes) or 'n'(no), 'q' quits":forzt=1to1000
1180 get p$:ifp$="y"then1220
1190 if p$="n"then1520
1195 ifp$="q"then20
1200 next zt
1210 goto1520
1220 open15,4,15:close15:ifst<>0thengosub50000:p$="n":goto1190
1225 open4,4:print#4,chr$(14);t$;z;chr$(15)
1230 forb=1to8
1240 forn=1tos
1250 on nt(b,n) goto1360,1370,1380,1390,1400
1260 on nt(b,n)-5goto1410,1420,1430,1440,1450
1270 on nt(b,n)-10goto1460,1470,1480,1490,1500
1280 print#4,n$,
1290 if n/s=int(n/s)thenprint#4," "
1300 ifn/s=int(n/s)then print#4,"--------------------------------------":goto1330
1310 if2*n/s=int(2*n/s)thenprint#4," "
1320 if2*n/s=int(2*n/s)then print#4,"......................................."
1330 ifn*b=s*8goto1510
1340 nextn
1350 nextb
1360 n$="d":goto1280
1370 n$="e":goto1280
1380 n$="f#":goto1280
1390 n$="g":goto1280
1400 n$="a":goto1280
1410 n$="b":goto1280
1420 n$="c#":goto1280
1430 n$="d^":goto1280
1440 n$="e^":goto1280
1450 n$="f#^":goto1280
1460 n$="g^":goto1280
1470 n$="a^":goto1280
1480 n$="b^":goto1280
1490 n$="c#^":goto1280
1500 n$="d^^":goto1280
1510 close4
1520 return
50000 rem no printer
50010 print"[147]"spc(10)"printer not on-line..."
50020 fordl=1to3000:next:return
50030 :
60000 rem quit
60010 print"[147] do you really want to quit?"
60020 poke198,0:wait198,1:geta$:ifa$<>"y"anda$<>"n"then60010
60030 ifa$="n"then20
60040 :
60050 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
60060 ifer<>63thenend
60070 load"hello connect",8
60080 end